perm filename PALIN2.PAS[S1,ALS] blob sn#478124 filedate 1979-10-02 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(* $A+,D+*)
C00008 ENDMK
CāŠ—;
(* $A+,D+*)

program	PALINDROME(OUTPUT);

const    NUMMAX = 3; PALMAX = 74;  NUMLIM = 5; PALLIM = 75;

var I, J, N, NUMVAL, PALVAL, CARRY : integer;
    NUM : array [1..NUMLIM] of integer;
    PAL,PAL2 : array [1..PALLIM] of integer;

begin
writeln (OUTPUT,
	'Additions			      Palindrome');
writeln (TTY,
	'Additions			      Palindrome');
for I := 1 TO PALMAX do PAL[I] := 0;
for I := 1 to NUMMAX do NUM[I] := 0;
NUM [1] := 6; NUM [2] := 9; NUM[3] := 1; NUMVAL := 3;		(* Initial conditions*)

    PALVAL := NUMVAL;
    N := 0;
    for I := 1 to NUMVAL do PAL[I] := NUM[I];
    for I := NUMVAL + 1 TO PALMAX do PAL[I] := 0;
    while PALVAL <= PALMAX do
	begin (* while PALVAL <= PALMAX*)
	I := 1; J := PALVAL;
	while ((PAL[I] = PAL [J]) and (I < J)) do
	    begin
	    I := I + 1;  J := J - 1;
	    end;
	if I < J then       (* Not a palindrome*)
	    begin
	    write (OUTPUT,N:4,' ');
	    for I := PALVAL + 1 to PALMAX do write (OUTPUT,' ');
	    for I := PALVAL downto 1 do write (OUTPUT,PAL[I]:1);
	    writeln (OUTPUT);
	    write (TTY,N:4,' ');
	    for I := PALVAL + 1 to PALMAX do write (TTY,' ');
	    for I := PALVAL downto 1 do write (TTY,PAL[I]:1);
	    writeln (TTY); BREAK;
	    J := PALVAL; CARRY := 0;
	    for I := 1 to PALVAL do
		begin
		PAL2[I] := PAL[I] + PAL[J] + CARRY;
		if PAL2[I] > 9 then
		    begin
		    PAL2[I] := PAL2[I] - 10;  CARRY := 1;
		    end
		else CARRY := 0;
		J := J - 1;
		end;
	    if CARRY = 1 then
		begin
		PALVAL := PALVAL +1;
		PAL2[PALVAL] := 1;
		CARRY := 0;
		end;
	    if PALVAL = PALMAX + 1 then
	        begin
		for I := NUMVAL + 1 to NUMMAX do
		    begin
		    write ( OUTPUT,' ');
		    write ( TTY,' ');
		    end;
		for I := NUMVAL downto 1 do
		    begin
		    write (OUTPUT, NUM[I]:1);
		    write (TTY, NUM[I]:1);
		    end;
		writeln (OUTPUT,' NOT FOUND in ',N:4,' additions to ',
			PALLIM:2,' CHARACTERS.');
		writeln (TTY,' NOT FOUND in ',N:4,' additions to ',
			PALLIM:2,' CHARACTERS.'); BREAK;
	        end
	    else
		begin
		for I := 1 to PALVAL do PAL[I] := PAL2[I];
		N := N +1;
		end;
	    end             (* Not a palindrome*)
	else if N <= 9 then PALVAL := PALLIM   (* Don't bother to print*)
	else
	    begin           (* A palindrome has been found*)
	    for I := NUMVAL + 1 to NUMMAX do
		begin
		write ( OUTPUT,' ');
		write ( TTY,' ');
		end;
	    for I :=NUMVAL downto 1 do
		begin
		write (OUTPUT, NUM[I]:1);
		write (TTY, NUM[I]:1);
		end;
	    write (OUTPUT,N:5);
	    write (TTY,N:5);
	    for I := PALVAL + 1 to PALMAX do
		begin
		write ( OUTPUT,' ');
		write ( TTY,' ');
		end;
	    for I := PALVAL downto 1 do
		begin
		write (OUTPUT, PAL[I]:1);
		write (TTY, PAL[I]:1);
		end;
	    writeln (OUTPUT);
	    writeln ( TTY); BREAK;
	    PALVAL := PALMAX +1;   (* To effect exit from while PALVAL < PALMAX*)
	    end (* a palindrome has been found*);
	end (* while PALVAL <= PALMAX*);
    CARRY := 1;
    for I := 1 to NUMVAL do
	begin
	NUM[I] := NUM[I] +CARRY;
	if NUM[I] > 9 then
	    begin
	    NUM[I] := NUM[I] - 10;
	    CARRY := 1;
	    end
	else CARRY := 0;
	end;
end.